home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / newsort.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1979-12-31  |  2.5 KB  |  115 lines
  1. 10  '*************************************************************************
  2. 20  '* For sorting DIALING DIRECTORY (PC-TALK.DIR) for PC-TALK  ver. III.    *
  3. 30  '*   written  by Jung W. Woo, Arlington, Va.              June, 1983.    *
  4. 40  '* This program also deletes unwanted items from the directory.  Just    *
  5. 50  '*   enter five dashes ("-----") in the name field before running.       *
  6. 60  '*                                                                       *
  7. 70  '*     (Alternate fields SORT added by Kyle Cummings 12-11-84)           *
  8. 80  '*************************************************************************
  9. 90  OPTION BASE1
  10. 100  DEFINT A-Z
  11. 110  DIM W$(60)
  12. 120  KEY OFF
  13. 130  CLS
  14. 140  LOCATE 2,15
  15. 150  PRINT "*** PC-TALK III Dialing Directory SORT program ***"
  16. 160  PRINT
  17. 170  PRINT
  18. 180  LOCATE,20
  19. 190  PRINT "1)  SORT on NAME FIELD"
  20. 200  LOCATE,20
  21. 210  PRINT "2)  SORT on PHONE NUMBER field"
  22. 220  LOCATE,20
  23. 230  PRINT "3)  SORT on COMM PARAMS field"
  24. 240  LOCATE,20
  25. 250  PRINT "99) EXIT to DOS"
  26. 260  PRINT
  27. 270  PRINT
  28. 280  LOCATE,15
  29. 290  INPUT "Enter: ",ANS
  30. 300  IF ANS=99 THEN SYSTEM
  31. 310  IF ANS>3 OR ANS<1 THEN GOTO 120
  32. 320  SORTKEY=ANS
  33. 330  CLS
  34. 340  LOCATE 12,30
  35. 350  PRINT "Sorting PC-TALK.DIR"
  36. 360  ON ERROR GOTO 1120
  37. 370  OPEN"PC-TALK.DIR" AS #1
  38. 380  FIELD #1,5 AS CK$
  39. 390  FIELD #1,104 AS RR$
  40. 400  FIELD #1,24 AS N$,36 AS R$,2 AS X$,4 AS B$,5 AS P$,2 AS T$,26 AS C$,3 AS L$,2 AS G$
  41. 410  GET#1,1
  42. 420  IF LEFT$(N$,10)<>"INITIALIII"THEN 1080
  43. 430  I=5
  44. 440  J=0
  45. 450  GET#1,I
  46. 460  LOCATE 12,50
  47. 470  PRINT I
  48. 480  IF CK$<>"-----" THEN J=J+1:W$(J)=RR$
  49. 490  I=I+1
  50. 500  IF I<65 THEN 450
  51. 510  F=1
  52. 520  I=1
  53. 530  ON SORTKEY GOTO 560,660,760
  54. 540  GOTO 840
  55. 550  '  -- Sort on NAME
  56. 560  LOCATE 13,37
  57. 570  COLOR 0,7
  58. 580  PRINT "SORTING.."
  59. 590  COLOR 7,0
  60. 600  IF MID$(W$(I),1,46)>MID$(W$(I+1),1,46) THEN SWAP W$(I),W$(I+1):F=0
  61. 610  I=I+1
  62. 620  IF I<J THEN 600
  63. 630  IF F=0 THEN F=1:I=1:GOTO 600
  64. 640  GOTO 840
  65. 650  '  -- Sort on PHONE NUMBER
  66. 660  LOCATE 13,37
  67. 670  COLOR 0,7
  68. 680  PRINT "SORTING.."
  69. 690  COLOR 7,0
  70. 700  IF MID$(W$(I),47,14)>MID$(W$(I+1),47,14) THEN SWAP W$(I),W$(I+1):F=0
  71. 710  I=I+1
  72. 720  IF I<J THEN 700
  73. 730  IF F=0 THEN F=1:I=1:GOTO 700
  74. 740  GOTO 840
  75. 750  '  -- Sort on COMM PARAMS
  76. 760  LOCATE 13,37
  77. 770  COLOR 0,7
  78. 780  PRINT "SORTING.."
  79. 790  COLOR 7,0
  80. 800  IF MID$(W$(I),63,7)>MID$(W$(I+1),63,7) THEN SWAP W$(I),W$(I+1):F=0
  81. 810  I=I+1
  82. 820  IF I<J THEN 800
  83. 830  IF F=0 THEN F=1:I=1:GOTO 800
  84. 840  FOR I=1 TO J
  85. 850     LSET RR$=W$(I)
  86. 860  PUT#1,I+4
  87. 870  NEXT I
  88. 880  LSET N$="------------------------"
  89. 890  RSET R$="- --- --- ----"
  90. 900  LSET X$=MKI$(14)
  91. 910  RSET B$="300"
  92. 920  LSET P$="E71NN"
  93. 930  LSET T$=MKI$(O)
  94. 940  LSET C$=STRING$(26,"/")
  95. 950  LSET L$=""
  96. 960  LSET G$=MKI$(0)
  97. 970  FOR I=J+5 TO 64
  98. 980     PUT#1,I
  99. 990  NEXT
  100. 1000  CLOSE
  101. 1010  BEEP
  102. 1020  LOCATE 13,37
  103. 1030  PRINT "DONE !!!!"
  104. 1040  FOR KK=1 TO 2500
  105. 1050  NEXT KK
  106. 1060  GOTO 120
  107. 1070  END
  108. 1080  BEEP
  109. 1090  PRINT"PC-TALK.DIR not initialized."
  110. 1100  CLOSE
  111. 1110  END
  112. 1120  CLOSE
  113. 1130  IF ERL=360 THEN PRINT"PC-TALK.DIR not found.":RESUME 1140
  114. 1140  END
  115.